VERSION 5.00
Begin VB.Form frmMain 
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   Caption         =   "Connect IV"
   ClientHeight    =   7965
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   10215
   ControlBox      =   0   'False
   FillStyle       =   0  'Solid
   Icon            =   "frmMain.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7965
   ScaleWidth      =   10215
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'This is Connect IV written by Biffa Sniffa in August 1999
'The controls are as follows
' :Left Arrow to move left
' :Right Arrow to move right
' :Space to drop piece into current slot
' :R Key to Reset the Game
' :Esc Key to End the Game
' Enjoy!
' Mr Snif.
Option Explicit
Const BTOP = 100
Const BLEFT = 100
Const BHEIGHT = 7865
Const BWIDTH = 10115
Const XTRAWID = 715
Const XTRAHGT = 655
Const HGT = 7740
Private Position(7, 6) As String
Private LPosition(7, 3) As Integer
Private GridPos(7, 6) As Integer
Private CurrColumn As Integer
Private PlayerNo As Integer
' form height is 7965
' form width is 10215
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    'MsgBox KeyCode
    '37 is left
    '39 is right
    '32 is space
    '27 is esc
    '82 is R(Restart)
               
    Select Case KeyCode
        Case 37 'Left key
            If CurrColumn = 1 Then
                'do nothing
            Else
                Call MovedColumn(CurrColumn - 1, CurrColumn)
            End If
        Case 39 'Right key
            If CurrColumn = 7 Then
                'do nothing
            Else
                Call MovedColumn(CurrColumn + 1, CurrColumn)
            End If
        Case 32 'Drop key
            Call Drop(CurrColumn, PlayerNo)
        Case 27 'ESC key
            End
        Case 82 'R key Restart
            Call Reset
    End Select
End Sub
Private Sub Form_Load()
    Dim i As Integer
    Dim j As Integer
    Dim PosX As Integer
    Dim posy As Integer
    PlayerNo = 1
    ' Draws the Blue Box using B for BOX and F for FILL
    Me.Line (BTOP, BLEFT)-(BWIDTH, BHEIGHT), vbBlue, BF
    ' Draw the circles for the pieces to fall into
    For i = 1 To 7
        For j = 1 To 6
            PosX = (1450 * i) - XTRAWID
            posy = (1330 * j) - XTRAHGT
            Me.FillColor = vbBlack
            Me.Circle (PosX, posy), 500, vbBlack
            
            'Sets an array with all positions
            Position(i, j) = CStr(PosX) & ":" & CStr(posy)
            If j = 1 Then
                LPosition(i, 0) = PosX - 550
                LPosition(i, 1) = posy - 550
                LPosition(i, 2) = PosX + 550
            End If
        Next j
    Next i
    Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 2), LPosition(1, 1)), vbWhite
    Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 0), (LPosition(1, 1) + HGT)), vbWhite
    Me.Line (LPosition(1, 2), LPosition(1, 1))-(LPosition(1, 2), (LPosition(1, 1) + HGT)), vbBlack
    Me.Line (LPosition(1, 0), LPosition(1, 1) + HGT)-(LPosition(1, 2), LPosition(1, 1) + HGT), vbBlack
    CurrColumn = 1
End Sub
Private Sub MovedColumn(NewCol As Integer, CurrCol As Integer)
    Dim i As Integer
    i = NewCol
    Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 2), LPosition(i, 1)), vbWhite
    Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 0), (LPosition(i, 1) + HGT)), vbWhite
    Me.Line (LPosition(i, 2), LPosition(i, 1))-(LPosition(i, 2), (LPosition(i, 1) + HGT)), vbBlack
    Me.Line (LPosition(i, 0), LPosition(i, 1) + HGT)-(LPosition(i, 2), LPosition(i, 1) + HGT), vbBlack
    i = CurrCol
    Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 2), LPosition(i, 1)), vbBlue
    Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 0), (LPosition(i, 1) + HGT)), vbBlue
    Me.Line (LPosition(i, 2), LPosition(i, 1))-(LPosition(i, 2), (LPosition(i, 1) + HGT)), vbBlue
    Me.Line (LPosition(i, 0), LPosition(i, 1) + HGT)-(LPosition(i, 2), LPosition(i, 1) + HGT), vbBlue
    CurrColumn = NewCol
End Sub
Private Sub Drop(CurrCol As Integer, Player As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim colpos As Integer
    Dim CurX As Integer
    Dim CurY As Integer
    i = CurrCol
    For j = 6 To 1 Step -1
        If GridPos(i, j) = 0 Then
            GridPos(i, j) = Player
            colpos = InStr(Position(i, j), ":")
            CurX = Left(Position(i, j), colpos - 1)
            CurY = Mid(Position(i, j), colpos + 1, Len(Position(i, j)))
            Select Case Player
                Case 1
                    Me.FillColor = vbYellow
                    Me.Circle (CurX, CurY), 475, vbYellow
                Case 2
                    Me.FillColor = vbRed
                    Me.Circle (CurX, CurY), 475, vbRed
            End Select
            Exit For
        End If
    Next j
    If PlayerNo = 1 Then
        PlayerNo = 2
    Else
        PlayerNo = 1
    End If
       
End Sub
Private Sub Reset()
    Dim i As Integer
    Dim j As Integer
    Dim PosX As Integer
    Dim posy As Integer
    For i = 1 To 7
        For j = 1 To 6
            GridPos(i, j) = 0
        Next j
    Next i
    PlayerNo = 1
    Call MovedColumn(1, CurrColumn)
    For i = 1 To 7
        For j = 1 To 6
            PosX = (1450 * i) - XTRAWID
            posy = (1330 * j) - XTRAHGT
            Me.FillColor = vbBlack
            Me.Circle (PosX, posy), 500, vbBlack
            
            'Sets an array with all positions
            Position(i, j) = CStr(PosX) & ":" & CStr(posy)
            If j = 1 Then
                LPosition(i, 0) = PosX - 550
                LPosition(i, 1) = posy - 550
                LPosition(i, 2) = PosX + 550
            End If
        Next j
    Next i
    Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 2), LPosition(1, 1)), vbWhite
    Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 0), (LPosition(1, 1) + HGT)), vbWhite
    Me.Line (LPosition(1, 2), LPosition(1, 1))-(LPosition(1, 2), (LPosition(1, 1) + HGT)), vbBlack
    Me.Line (LPosition(1, 0), LPosition(1, 1) + HGT)-(LPosition(1, 2), LPosition(1, 1) + HGT), vbBlack
    CurrColumn = 1
End Sub